perm filename NS[F8,ALS]1 blob sn#310375 filedate 1977-10-15 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00004 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	*CHECKERS as of October 13 1977
C00037 00003	*SUBROUTINES
C00080 00004	* FKT  GMEN  RFJN  LFJN  STMV
C00141 ENDMK
C⊗;
*CHECKERS as of October 13 1977
*
*Register usage
*       SC      in SELE         in FIND         in EVAL         in AFT
*       0       Temporary use only
*       1       
*       2       King indicator
*       3       Byte
*       4       Byte #
*       5       Byte Info
*       6       Extracted bit   
*       7       ** Reserved for Color reversal * * * * * * * * * * * * *
*       8       Reserved for interrupt service
*
*Resident package addresses
JOYT    EQU     H'0C00'
LINE    EQU     H'0FDF'
SHCB    EQU     H'0FE2'
INPF    EQU     H'0FE3'
WTLN    EQU     H'0FE5'
TXC     EQU     H'0FE8'
CMRG    EQU     H'0FEA'
DBNC    EQU     H'0FEB'
UPI     EQU     H'0FFA'
JOYI    EQU     H'21AD'
IJS     EQU     H'22DB'
SHL     EQU     H'27C6'
SHR     EQU     H'27D3'
PUSH    EQU     H'40A9'
POPS    EQU     H'40BC'
SPS     EQU     H'40D0'
WDG     EQU     H'4105'
WAUD    EQU     H'41C8'
WAU1    EQU     H'41CC'
CDS     EQU     H'41D5'
WMS     EQU     H'4205'
UDAT    EQU     H'424D'
TRAN    EQU     H'43CD'
FCS     EQU     H'43D6'
WAIT    EQU     H'4501'
TIR     EQU     H'45DB'
CLER    EQU     H'4762'
*Misc. constants
TCMD    EQU     H'44'
BCMD    EQU     H'6D'
TCOL    EQU     H'80'   TEXT COLOR
ULIN    EQU     H'F5'
COM     EQU     H'8F7'
*
*RAM assignments
PLY0    EQU     H'0C20'        Place for player's ply depth choice
COL0    EQU     H'0C21'        Place for color choice(next after PLY0)
SELX    EQU     H'0C22'        SELE exit (0 norm, 1 M's 1st, -1 P's 1st)
XPOS    EQU     H'0C23'        XPOSITION(CURSOR)
YPOS    EQU     H'0C26'        YPOSITION(CURSOR)
BFLG    EQU     H'0C27'
BLNF    EQU     H'0C28'        Blink flag
XBLN    EQU     H'0C29'        X value to blink
YBLN    EQU     H'0C2A'        Y value to blink
BCNT    EQU     H'0C2B'        Counter used in OKMV
BKMV    EQU     H'0C2C'        Data to index book moves
OBJ0    EQU     H'0C30'        Board 1, thru H'0E0F'
TREE    EQU     H'0E10'        Tree data, thru H'0EFF', Player's board first
TRE2    EQU     H'0E20'        Machine's first board here
HSAV    EQU     H'0E59'        H save location
PLMD    EQU     H'0E5B'        Used for temp store of player's move inf
PLMV    EQU     H'0ED0'        Overlay region used for player's moves
PLMF    EQU     H'0EE0'           and move numbers
MOBS    EQU     H'0F00'         Mobility and DJ flags (14 bytes)
OBJ1    EQU     H'0F10'        Board 2, thru H'0FAF'
*
*Scratch pad assignments
TEMP   EQU     H'8'
J      EQU     H'9'
HU     EQU     H'A'
HL     EQU     H'B'
PLOC   EQU     O'3'            LISU value for ACTIVE and PASSIVE
KLOC   EQU     O'4'            LISU value for KING's and special data
ELOC   EQU     O'5'            LISU value for EMPTY's area
ISA    EQU     O'30'           ISAR value for active area
ISP    EQU     O'34'           ISAR value for passive
ISK    EQU     O'40'           ISAR value for kings
ISE    EQU     O'51'           ISAR value foempty (with offset)
*Mimimum ply depths
PLYT   EQU     H'FE'           Ply depth for Robot Tom (stored as neg.)
PLYD   EQU     H'FD'           Ply depth for Robot Dick
PLYH   EQU     H'FC'           Ply depth for Robot Harry
*SPECIAL CONSTANTS
X       EQU     H'1'
Y       EQU     H'2'
VX      EQU     H'3'
VY      EQU     H'4'
CHT     EQU     H'3'    CURSOR HEIGHT
YTST    EQU     H'9'
MAXY    EQU     H'4D'   MAX Y COORD (=H'4F'-CHT)
*
       ORG     H'1000'
       DC      H'AA'
       DC      H'55'
       DC      H'00'   BACKGROUND COLOR
       DC      H'00'   BACKGROUND COLOR
       DC      H'00'   SPACES
       DC      H'00'   SPACES
       DC      H'3119' CH
       DC      H'0B31' EC
       DC      H'150B' KE
       DC      H'0921' RS
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
*CHECKERS PACKAGE                      *
*                                      *
*  ALGORITHM BY PROF. A. SAMUEL        *
*  I/O ROUTINES BY N. SHAPERO          *
*
       PI      CDS     CLEAR DISPLAY
       PI      IJS     INITIALIZE JOYSTICK TABLE
        LISU    2      For safety only, can be removed later
        LISL    6
        CLR
        XS      S
        BM      QN1     Is clock running?
        LI      H'81'   No, so start it
        LR      D,A
        LIS     2
        LR      S,A
QN1    LIS     H'4'
       LR      0,A
       PI      SEDC    SET MESSAGE LNGTH&LINE POINTER
       DS      1
       DS      1       SET DEFAULT PLY DEPTH
       DCI     SKL
       PI      WMS     WRITE MESSAGE
       PI      RKB     AND DO KEYBOARD READ
       CI      H'1F'
       BZ      QN10    IS IT 'DICK'?
       CI      H'19'   NO.
       BNZ     QN11    IF NOT 'HARRY', THEN 'TOM'
       DS      1
QN10   DS      1
QN11   DCI     PLY0
       LR      A,1     GET CORRECT PLY DEPTH
       ST              AND SAVE IT.
       DS      0
       DS      0       SET FOR BUT TWO LINES
       PI      CDS     CLEAR DISPLAY
       PI      SEDC    SET LINE POINTER
       LI      H'FA'
       AS      S
       LR      S,A     SET FOR BUT H'1A' LENGTH
       DCI     YMF     DCO TO MESSAGE START
       PI      WMS     SO WRITE MESSAGE
       PI      RKB     READ KEYBOARD
       CI      H'2B'   Is answer an N?
     DCI      COL0
     CLR
     LR       7,A     Black plays first always
     BZ       QN13    N means machine first
     COM
     ST               COL0←-1, player is black
     ST               SELX←-1, player first
     BR       QN14
QN13 ST               COL0←0, machine is black
     INC
     ST               SELX←+1, machine first
QN14 DCI      BLKM    Table of possible moves
        XDC
        DCI     PLMV    List to verify moves
        LIS     H'7'
        LISU    2
        LISL    0
        LR      S,A             SET TRANSFER COUNT
        PI      TRAN            DO TRANSFER
        DCI     BKMV
        CLR
        ST                Clear Book move index value
*Now set up board
       DCI     CMRG
       LI      H'65'
       ST              SET FOR X & Y ZOOM
        PI      BRDI             Set up initial board
        DCI     XPOS
        LIS     H'0'
        ST                      SET FOR LEFT MOST
        LI      H'3'
        ST
        LIS     H'0'
        ST
        DCI     YPOS
        LIS     H'0'
        ST                      AND SET FOR TOPMOST
*Start play
        DCI     COL0
        CLR
        XM
        BM      PMOV
*Machine is to play black
        LISU    2
        LISL    5
        LR      A,S             Used as random number
        NI      H'7'            Save last 3 bits
        LR      0,A             Use this number to select move
        DCI     BKMV            Book move index
        SL      4               Save space for second move
        SR      1
        ST                      Record first move
        DCI     PLMV
QN17    LM                      Get byte record
        LR      1,A
QN18    LR      A,1
        NS      1
        BNZ     QN19            Is this byte exhausted?
        LM                      Step over byte info
        BR      QN17            Go to next byte record
QN19    LR      2,A
        AI      H'FF'           Subtract 1
        NS      1
        LR      1,A             byte less rightmost bit
        XS      2               This leaves 1 bit in A
        DS      0
        BP      QN18
        LR      6,A             Save the byte bit
        LM                      Get the byte info
        LR      4,A             The byte indicator
        DCI     TRE2            Machine's board is here
        LR      H,DC
        LIS     H'C'
        ADC
        LR      A,6
        ST
        LR      A,4
        ST
        JMP     SEL2            Go to SELE to make move
*           Use std code to make move
*Prepare for player's move
PMOV    PI      MVC             Initiate cursor
        DCI     TREE            Player's board is here
        LR      H,DC
MES0    CLR                     "YOUR MOVE"
MES1    LR      0,A             Identify message
        PI      WMC             Write message
        DCI     BLNF
        CLR
        ST
        LR      DC,H
CUR1    PI      CURS            Initiate cursor
        NOP
        NOP
        NOP
        NOP
* Can this piece move?
* Enter with X in 1, Y in 2, byte in 3 and byte # in 4
OKPI    DCI    PLMV            Possible moves listing
OKP1    LM                      Get move byte
        NI      H'FF'
        BNZ     OKP3            An entry found
        LR      A,5             Byte info
        NI      H'10'           Extract J bit
        LIS     H'5'            "PIECE CAN'T MOVE"
        BZ      OKP2
        LIS     H'1'            "MUST JUMP"
OKP2    BR      MES1            Try again
OKP3    NS      3               Compare
        BNZ     OKP4            This might be the one
        LM                      A cheap way to index
        LR      5,A             Save for jump info
        BR      OKP1            Try again
OKP4    LM                      Next entry is the byte info
        LR      5,A             Save it
        SR      1
        SR      1
        NI      H'3'           Remove the J bit and the direction
        XS      4               Does it match?
        BNZ     OKP1            Try again
        DCI     PLMD            Save data as to starting square
        LR      A,1             X
        ST
        LR      A,2             Y
        ST
        LR      A,3             Byte
        ST
        LR      A,4             Byte info
        ST
        LI      -H'4'
        DCI     BCNT            Counter
        ST
        DCI     BLNF            Blink flag
        LIS     H'1'            Set on
        ST
        LR      A,1             Save X value
        ST                      in XBLN
        LR      A,2             Save Y value
        ST                      in YBLN
CUR2    PI       CURS            USE  CTMP TO DEBUG
        DCI     PLMD+2          Restore initial values
        LM
        LR      3,A             for BYTE
        LM
        LR      4,A             and BYTE number
*Now test indicated move for legality
OKMV    DCI     PLMD            Saved data location
        LM                      Get the old X value
        COM
        INC
        AS      1               This gives us the change in X
        BZ      NON2            Illegal
        LR      1,A             Save the difference
        BP      OKM1
        COM
        INC
OKM1    LR      0,A             |∂X|
        CI      H'2'
        BM      NON3            Too far
        CLR                     Anticipate normal move
        BNZ     OKM2
        LI      H'10'           Set Jump bit
OKM2    LR      6,A             save byte info here
        LM                      Get the old Y value
        COM
        INC
        AS      2
        LR      2,A             Change in Y
        BM      OKM3
        COM
        INC
OKM3    AS      0
        BNZ     NON2            |∂X|≠|∂Y|
        LR      A,2
        NS      2
        BP      OKM4
        LIS     H'2'            Backward bit
        AS      6
        LR      6,A
OKM4    LR      A,1
        NS      1
        BM      OKM5            
        LIS     H'1'            Left bit
        AS      6
        LR      6,A
OKM5    LR      A,4             Get initial Byte #
        SL      1               Shift it left to position
        SL      1
        AS      6               Add in the J and Direction bits
        LR      6,A            Final byte info from cursor
        DCI    PLMV            Possible moves listing
        LIS     H'8'            7 moves possible
        LR      0,A
OKM6    CLR
        XM
        BZ      NONO            No more entries
        LR      1,A
        LM
        LR      5,A             Save byte info
OKM7    CLR
        XS      1
        BZ      OKM6            Last bit tested
        LR      2,A             We'll need it again
        AI      H'FF'           Subtract 1
        NS      1
        LR      1,A             Byte with bit removed
        XS      2               Get extracted bit
        NS      3               Does it check with 3
        DS      0               Count tries
        BZ      OKM7            Not in table entry, try again
        LR      A,5             But does byte info agree?
        XS      6               Compare 6 with table value
        BNZ     OKM7            No so count remaining bits in 1
        LIS     H'7'            Found, so reorder count
        XS      0               order from 0 thru 6
        DCI     BKMV
        LR      Q,DC
        OM                      Save info in left half, if any
        LR      DC,Q
        ST                      Save move count for book move entry
        DCI     TREE            Store final values
        LR      H,DC
        LIS     H'C'
        ADC
        LR      A,3
        ST                      Store byte
        LR      A,6
        ST                      And byte info
        PI      MVC             Turn off cursor
        JMP     SEL2
NONO    LR      A,5
        NI      H'10'           A jump required?
        LIS     H'2'
        BZ      NON4
        LIS     H'1'
        BR      NON4
NON2    LIS     H'2'
        BR      NON4
NON3    LIS     H'3'
NON4    LR      0,A
        DCI     BCNT
        LM
        INC
        DCI     BCNT
        ST
        BM      NON5
        JMP     MES0
NON5    PI      WMC
        JMP     CUR2
*-*-*-*-*-*-*-*-*-*-
*      KEYBORD READ
*
RKB    LR      K,P
       PI      PUSH
       LISU    2
       LISL    4       SET ISAR FOR DELAY TIMER
       LIS     H'0'
       LR      S,A     SET FOR MAX DELAY
RKB1   PI      FCS     FETCH CHARACTER
       BZ      RKB1    NULL INPUT?
       BM      RKB1    NO. DEBOUNCED INPUT?
       PI      POPS    YES. POP RETURN ADDRESS
       LR      A,8     GET KEYBOARD INPUT
       PK              AND RETURN
*-*-*-*-*-*-*-*-*-*-*-*-
*Initial moves for black
*
BLKM   DC      B'11110000'      4 pieces
       DC      B'00000100'      Byte 1, RF
       DC      B'11100000'      3 pieces
       DC      B'00000101'      Byte 1, LF
       DC      B'01000000'      11-15 repeat to give
       DC      B'00000100'      a slight preference
       DC      H'00'
*Initial moves for red
REDM   DC      B'00000111'      3 pieces
       DC      B'00001010'      Byte 2, RB
       DC      B'00001111'      4 pieces
       DC      B'00001011'      Byte 2, LB
       DC      H'00'
*-*-*-*-*-*-*-*-*-*-*-*-*-*-
*      BOARD IMAGE ROUTINE
*
BRDI    LR      K,P     SAVE RETURN
        PI      PUSH
        PI      CLER    TURN OFF CURRENT OBJECTS
        PI      BORD    GENERATE BOARD
        PI      SURP    SET UM1 REGS AND POINTERS
*PUT IN INTIAL PIECES BOTH IN SCRCHPAD
*AND IN BLOCKS 0 OR 1
*
        LISU    PLOC            LOAD SCRATCHPAD AS
        LISL    7               FOLLOWS:
        CLR
BRDJ    LR      D,A             O'30'=FF
        BR7     BRDJ            O'31'=F0
        COM                     O'32'=0
        LR      I,A             O'33'=0
        LR      I,A             O'34'=0
        SL      4               O'35'=0
        LR      I,A             O'36'=F
        LISL    6               O'37'=FF
        LIS     H'F'
        LR      I,A
        LISU    KLOC
        LISL    H'7'
        CLR
BRDK    LR      D,A             O'40' thru O'47' = 0
        BR7     BRDK
        LISL    6               Except
        LI     H'80'            O'46' to contain H'80'
        LR      S,A
        DCI     TRE2
        PI      SCRD
        DCI     TREE
        PI      SCRD
        PI      MEN
        PI      POPS
        PK
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
* Read internal representation of board
* and put pieces in the board image.
*
MEN     LR      K,P             SAVE RETURN ADDRESS
        LISU    3               START WITH PIECES
        LIS     H'1'            1 for red pieces (stored first)
        LR      4,A             Piece, (1 Red, 0 Black, -1 King)
        DCI     COL0
        CLR                     CLEAR ACC
        XM                      IN W/STATUS
        LR      0,A
        LISL    O'7'            Decrement and shift right
        BNZ      MEN1            if COL0 is FF (BLACK at bottom of screen)
        LISL    O'0'            Increment and shift left
MEN1    LIS     H'3'             if COL0 is 0 (Black at top of screen)
        LR      1,A             To count bytes
        NOP
        NOP
        NOP
        NOP
MEN2    LIS     H'7'
        LR      2,A             To count bits
        DCI     TAB1            Byte location table
        LR      A,1             This byte number
        SL      1               Locations occupy 2 bytes each
        ADC                     
        LM                      Get the byte location
        LR      QU,A            and save it in Q
        LM
        LR      QL,A
        LR      A,0
        NS      0
        BNZ     MEN5            Decrement and shift right if COL0 is FF
        LR      A,I             Increment and shift left if COL0 is 0
        NOP
        NOP
        NOP
        NOP
        BR      MEN4
MEN3    LR      A,3
        SL      1               and shift left
MEN4    LR      3,A
        NI      H'80'           (done this way for symry
        BZ      MEN9
        BR      MEN8
MEN5    LR      A,D             Decrement if COL0 is FF
        NOP
        NOP
        NOP
        NOP
        BR      MEN7
MEN6    LR      A,3
        SR      1               and shift right
MEN7    LR      3,A
        NI      H'1'
        BZ      MEN9
MEN8    DCI     TAB2            Relative-locations-of-squares table
        LR      A,2             This square
        ADC
        LM                      Get square displacement
        LR      DC,Q            Recall the location for the input byte
        ADC                     This is the square position
        LR      A,4             Identify type of piece
        NS      4
        BM      PUTK            To put down a king
        LIS     H'4'            Prepare for a piece
        LR      5,A             To count lines
        LI      H'20'           Skip the rst 4 lines (4*8)
        ADC
        XDC
        DCI     BLKP            Anticipate a black piece
        BZ      PUTL            A black piece (status bit still ok)
        DCI     REDP            No, it's a red piece
        BR      PUTL
PUTK    LIS     H'2'            Only 3 lines for a crown
        LR      5,A
        LIS     H'8'            To skip 1 line
        ADC
        XDC
        DCI     KING
PUTL    LM                      Put loop
        XDC
        ST
        LIS     H'7'            To next line on screen (less increment)
        ADC
        XDC
        DS      5
        BP      PUTL            Loop
MEN9    DS      2
        BM      ME10
        LR      A,0
        NS      0
        BNZ     MEN6            Shift right if COL0 is FF
        BR      MEN3            Shift left if COL0 is 0
ME10    DS      1
        BP      MEN2
        LR      A,4
        NS      4
        BM      BDEX            Exit from board routine
        DS      4
        BP      MEN1            Go round again for black pieces
        LISU    H'4'            Get set for kings
        LR      A,0
        NS      0
        LISL    H'3'            Decrementing case
        BNZ     MEN1            Dedrement and shift right if COL0 is FF
        LISL    H'0'            Incrementing case
        BR      MEN1            Increment and shift left if COL0 is 0
BDEX    PK
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
*      BORD GENERATES BOARD IMAGE
*
BORD   LR      K,P
       LI      H'FF'
       LR      3,A     REG3=FF
       DCI     OBJ0    BRD1 START ADDRESS
       LIS     H'2'    FLAG FOR BOR
       LR      4,A     SET REG 4 = 2
       LIS     H'6'
BRD4   LR      0,A     REG0 = 6 ROWS
BRD3   LIS     H'A'
       LR      1,A     REG 1 = 10 LINE/ROW
BRD2   LIS     H'4'
       LR      2,A     REG2=SQ PAIRS/ROW
BRD1   LR      A,3
       ST              STORE IN BRD
       COM
       ST              NEXT IS COMPL. OF FIRST
       DS      2
       BNZ     BRD1    MORE FOR THIS ROW
       DS      1       NO, ALL LINE DONE
       BNZ     BRD2
       LR      A,3     DONE A TIMES YET
       COM
       LR      3,A
       DS      0       DEC ROW COUNT
       BNZ     BRD3    ALL ROWS DONE?
       DS      4
       BZ      BRD5    BOTH OBJECTS DONE?
       DCI     OBJ1    NO,GET BORD2 ADDRS.
       LIS     H'2'
       BR      BRD4    REG0=2
BRD5   PK
*-*-*-*-*-*-*-*-*-*-*-*-*-*    
*      SURP SETS UM1 REGS & PTRS
*
SURP    LR      K,P             SAVE RETURN ADDRESS
        PI      PUSH            AND PUSH IT ONTO STACK
        PI      CLER            CLER UM1 REGISTERS
        DCI     UPI             DCO TO UPDATE CONTROLS
   LIS H'3'
        ST                      SET INTO COUNT
        CLR
        ST                      SET FOR FULL INIT
        LI      INIT:
        ST
        LI      INIT.
        ST                      AND SET ADDRESS
        PI      WAUD            WAIT, THEN UPDATE
        LIS     H'5'
        LR      S,A             GET TRANSFER COUNT
        DCI     BDAT            SET SOURCE
        XDC                     INTO DC1
        DCI     UPI+1           DESTINATION
        PI      TRAN            TRANSFER DATA
        JMP     WAU1            WAIT, DO UPDATE, RESET ISAR&RET.
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
*       UPDATE CONTROL DATA     *
*
BDAT    DC      H'1'            FLAG SET SHORT UPDATE
        DC      UDIT:
        DC      UDIT.
        DC      UDIT:
        DC      UDIT.
*
* Subroutine to move data from RAM to S O'30' thru O'47' with the data f
* S O'30' thru O'43' coming from the current block.  Data for O '44' thr
* O'47' is from the previous block, with some items deleted.
*
NOOP    POP                     DUMMY ROUTINE
*SUBROUTINES
*-*-*-*-*-*-*-*-*-*-*-*-*-*
* RA to SC
*
RASC    LR      K,P             Save return address
        PI      PUSH
        LISU    PLOC           ←SC buffer with Active and Passive
        LISL    0
        LIS     H'8'
        LR      0,A
        PI      RASL
        LISU    KLOC            SC buffer with Kings
        LISL    0
        LIS     H'4'
        LR      0,A
        PI      RASL
        LI      H'F1'           Rest of data from earlier block
        ADC
        CLR                     Zero the MOVE byte
        LR      I,A
        LM
        NI      H'E0'           Save Piece debit only
        LR      I,A
        LM
        LR      I,A             Keep both SCORE bytes
        LM
        LR      I,A
        PI      POPS
        PK
*
RASL    LR      K,P
RAS2    LM
        LR      I,A
        DS      0
        BNZ     RAS2
        PK
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
* moves 16 bytes from SC O'30' thru O'47' to RAM direct.
*
SCRD    LR      K,P
        PI      PUSH
        LISU    PLOC
        LISL    0
        LIS     H'8'
        LR      0,A
        PI      SCRL
        LISU    KLOC
        LISL    0
        LIS     H'8'
        LR      0,A
        PI      SCRL
        PI      POPS
        PK
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
* Moves 16 bytes from SC O'30' thru O'47' to RAM, reversing
* ACTIVE and PASSIVE and letting some items remain
*
SCRA    LR      K,P
        PI      PUSH
        LISU    PLOC
        LISL    4
        LIS     H'4'
        LR      0,A
        PI      SCRL
        LISL    0
        LIS     H'4'
        LR      0,A
        PI      SCRL
        LISU    KLOC
        LISL    0
        LIS     H'4'
        LR      0,A
        PI      SCRL
        LR      A,I             To index only
        CLR                     Zero MOVE byte
        ST
        LR      A,I
        NI      H'E0'           Save piece debit only
        LR      A,I
        ST                      Save both SCORE bytes
        LR      A,I
        ST
        PI      POPS
        PK
*
SCRL    LR      K,P
SCR3    LR      A,I
        ST
        DS      0
        BNZ     SCR3
        PK
*
*To compute 4 bytes which show the empty squares on the board and store
*them in O'51' thru O'54' with O'50' and O'55' set to zero as guards.
*Note especially that the EMPTY locations are displaced relative to ACTI
EMPTY   LR      K,P
        LISU    ELOC
        LISL    0
        CLR
        LR      S,A             Make sure guard byte is empty
        LISU    PLOC            Start with ACTIVE
        LIS     H'4'
        LR      0,A
        BR      EMP3
EMP2    LR      A,IS
        AI      H'30'           Actually subtracting 16
        LR      IS,A
EMP3    LR      A,S
        LR      1,A
        LR      A,IS
        AI      4
        LR      IS,A
        LR      A,S
        AS      1
        LR      1,A
        LR      A,IS
        AI      H'D'            Add 13o get to the correct EMPTY locat
        LR      IS,A
        LR      A,1
        COM                     Reverse 1's and 0's
        LR      S,A
        DS      0
        BNZ     EMP2
        CLR
        LR      S,A             Upper guard byte
        PK
*
*Subroutine to count bits in 0 and return count in A
*Uses registers 0 and 1
CAQ     LR      K,P
        CLR
        LR      1,A
        LR      A,0
        BR      CAQ3
CAQ2    DS      1
        AI      H'FF'
        NS      0
        LR      0,A
CAQ3    BNZ     CAQ2
        LR      A,1
        COM
        INC             Make it into a true positive number
        PK
*
*Subroutine to multiply 2 positive binary numbers (the smaller in SC 1 a
*the larger in SC 2) by Russian multiplication.  SC 0 is used to accumul
*the product.  This code may be used at only one place and can probably
*written in line at that place with some saving of space.
*
MPYR    LR      K,P
        CLR
        LR      0,A             To accumulate the product
        LR      A,1
MPY1    NI      H'1'            Is the rightmost bit a 1?
        BZ      MPY2            No
        LR      A,2
        AS      0
        LR      0,A
MPY2    LR      A,2
        SL      1
        LR      2,A
        LR      A,1
        SR      1
        LR      1,A
        BNZ     MPY1            Product is not complete
        PK
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
*SET MESSAGE LENGTH&LINE PNTR
*
SEDC   DCI     LINE    DCO TO LINE POINTER
       LIS      H'2'
       SL     4        SET FOR SECOND LINE
       ST
       LR     A,0
       SL     4
       LISL   4
       LR     S,A      AND SET MESSAGE LENGTH
       CLR             CLEAR ACC
       LR     1,A      AND SET DEFAULT RESULT
       POP             N RETURN
*-*-*-*-*-*-*-*-*-*-*-*
*ADDRESS TABLE FOR MVC*
*
TABL   DC      H'0C30'
       DC      H'0C80'
       DC      H'0CD0'
       DC      H'0D20'
       DC      H'0D70'
       DC      H'0DC0'
       DC      H'0F10'
       DC      H'0F60'
*-*-*-*-*-*-*-*-*-*-*-*
*INTERRUPT ENABLE FOR *
*UPDATE DURING COMPUTE*
*OF NEW CHECKER MOVES.*
*
ENIN   LI      INHR:
       OUTS    H'C'
       LI      INHR.
       OUTS    H'D'    SET INTERRUPT VECTOR
       DCI     H'8F0'
       LI      ULIN
       ST              SET INTERRUPT LINE
       DCI     CMRG    DCO TO PROG COPY COMREG
       LR      Q,DC    SAVE ADDRESS IN Q RES
       LIS     H'8'
  OM
       LR      DC,Q
       ST              IN PROGRAM COPY
       DCI     H'8F7'
       ST              DITTO UM1 COPY
       LIS     H'1'
       OUTS    H'E'    ENABLE SMI...
       EI              ENABLE CPU
       LR      J,W     SAVE SAME STATUS
       POP             AND RETURN
*-*-*-*-*-*-*-*-*-*-*-*
*AND ROUTINE TO TURN  *
*THE INTERRUPT OFF.   *
*
DAI    DI              DISABLE CPU INTERRUPT
       LR      J,W     SET J ACCORDINGLY
       DCI     CMRG    DCO TO PROG COPY COMREG
       LR      Q,DC    SAVE ADDRESS
       LIS     H'8'
       COM
       NM              TURN OFF BIT
       LR      DC,Q    IN THE
       ST              PROGRAM COPY,
       DCI     H'8F7'
       ST              AND THE UM1 COPY
       CLR
      OUTS    H'E'    NOW DISABLE SMI
       POP             AND RETURN
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
*CURSOR MOVEMENT ROUTINE--USES*
*REGISTERS 0,1,2,3,4,HU,Q,K,W,*
*SP20-24.                     *
*
CURS   LR     K,P      SAVE RETURN ADDRESS
       PI     PUSH     AND PUSH IT ON TO STACK
       PI     DAI      DISABLE INTERRUPT DRIVEN UPDATE
MAP0   PI     WAUD     WAIT, THEN UPDATE
       LIS    H'8'
MAP1   DCI    H'8FB'   DCO TO CURRENT Y LO
       CM
       BNZ    MAP1     TO START OF DISPLAY?
       LIS    H'1'     YES, CAN START JOYREAD
       LR     HU,A     SET FOR HORIZONTAL POT
       PI     JOYI     AND READ
       LR     VX,A     SAVE RESULT IN VX
       LIS    H'0'
       LR     HU,A     SET FOR VERTICAL POT
       PI     JOYI
       LR     0,A      SAVE IN REG 0
       PI     AMAP     CONVERT TO PROPER VELOCITY
       LR     VY,A     SAVE RESULT
       LR     A,VX
       LR     0,A    NOW GET UNCOVERTED VX INTO R0
       PI     AMAP     CONVERT IT
       LR     VX,A     AND SAVE IT
       PI     WAUD     WAIT, THEN UPDATE
       PI     BLNK      To blink code (on)
       LIS    H'4'
       LR     0,A
MP01   LIS    H'8'
MP02   DCI    H'08FB'  Delay loop
       CM
       BNZ    MP02
       PI     WAUD     A second wait
       DS     0
       BNZ    MP01
       PI     BLNK      To blink code (off)
       CLR             CLEAR ACC
       XS     VX       VX IN W/STATUS
       BZ     MAP7     NON-NULL X COMPONENT?
       DCI    XPOS     YES
       LM
       LR     X,A      SET CURRENT X POSITION
       LISU   2
       LISL   0
       CLR
       LR     I,A      SP20<=0
       LM
       LR     I,A      SP21<=NON NULL LEAD MASK
       LM
       LR     S,A      SP22<=TRAILING MASK
       CLR
       XS     VX       VX IN W/STATUS
       BM     MAP3     GOING LEFT?
       PI     SHR      SHIFT RIGHT ONE
       LIS    H'7'     NO, GOING RIGHT.
       XS     X
       BNZ    MAP5     IN RH MOST BOX?
       LISL   2        YES
       XS   S
       BZ     MAP5     TRIED TO GO TOO FAR?
MAP2   CLR             YES.
       LR     VX,A     CLEAR X VELOCITY
       BR     MAP7     AND CHECK Y
MAP3   PI     SHL      SHIFT LEFT ONE
       CLR
       XS     X
       BNZ    MAP4     IN LH MOST BOX?
       LISL   0        YES
       XS     S
       BNZ    MAP2     TRIED TO GO TOO FAR?
MAP4   LISL   0
       CLR
       XS     S
       BZ     MAP7     IS SP20 NULL?
       LISL   1        NO.
       LR     A,I
       LR     S,A
       LISL   0
       LR     A,I
       LR     D,A
       CLR
       LR     S,A      SP22<=SP21,SP21<=SP20,SP20<=0,THAT ORDER
       DS     X        AND DECREMENT X COUNT
       BR     MAP7     NOW GO CHECK Y
MAP5   LISL   1
       CLR             CLEAR ACC
       XS     S
       BNZ    MAP7     IS SP21=0?
       LISL   2
       LR     A,D
       LR     I,A
       CLR
       LR     D,A      SP21<=SP22,SP22<=0, THAT ORDER
       LIS    H'1'
       AS     X
       LR     X,A      INCREMENT X COUNT
MAP7   CLR
       XS     VY
       BZ     MAP9     VY=0?
       DCI    YPOS     NO, SET DCO TO LAST Y POSITION
       AM              UPDATE Y COORD
       BM     MP7A    Result Y is neg?
       CI     MAXY     COMPARE W/MAX ALLOWED Y
       BC     MAP8     NEW Y>MAX ALLOWED VALUE?
MP7A   CLR             YES
       LR     VY,A     RESET VY
       BR     MAP9
MAP8   LR     Y,A      SET NEW Y
MAP9   LR     A,VY     GET VY
       SL     1
       XS     VX
       BZ     MP12     ANY MOVEMENT?
       PI     MVC      YES, REMOVE OLD POSITION
       CLR
       XS     VY
       BZ     MP10     ANY Y MOVEMENT?IF NOT, MUST HAVE VX NE 0
       DCI    YPOS
       LR     A,Y      IS, SO RESET
       ST              Y POSITION
       CLR
       XS     VX
       BZ     MP11     ANY X MOVEMENT?
MP10   DCI    XPOS     UPDATE X POSIT & MASK
       LR     A,X
       ST
       LISL   1
       LR     A,I
       ST
       LR     A,S
       ST
MP11   PI     MVC      DISPLAY NEW POSITION
MP12   CLR
       OUTS   1        Clear port 1
       NOP             3 NOP's for FCC
       NOP             Do not remove
       NOP             for any reason
       INS    1        Get buttons
       NI     H'1'     Strip to desired one
       DCI    BFLG    To button flag
       CLR
       BNZ    MP13    Any button input?
       ST             No, reset edge flag
MP14   JMP    MAP0    And go try again
MP13   LR     Q,DC    Save address
       XM             Flag in W/STATUS
       BNZ    MP14    Previous input?
       LIS    H'1'    No, reset flag
       LR     DC,Q    Recover address
       ST             And reset
CON    CLR  
        LR      0,A     Set counter (Y conversion)
CON1    LR      A,Y     Get Y coordinate
        CI      YTST    Compare W/test value
        BC      CON2    Y LE test value?
        LR      A,0     No, increment counter
        INC
        LR      0,A
        LI      -H'A'
        AS      Y
        LR      Y,A     Y←Y-H'A'
        BR      CON1    Go back and try agian
CON2    LR      A,0     Get counter
        LR      Y,A     Y now  (0-7):(top-bottom)
        AS      X
        NI      H'1'
        BZ      MP14    On a legal square?
        DCI     COL0    Yes
        CLR
        XM              Flag in W/STATUS
        BP      CON3    Machine plays RED?
        LIS     H'7'    Yes
        XS      Y
        LR      Y,A     Y←7-Y
        LIS     H'7'
        XS      X
        LR      X,A     X←7-X
CON3    LR      A,Y
        SR      1
        LR      VY,A    VY reg (BYTENO)←(1/2*(7-Y)
        DCI     BYDT    To BYTE data
        LR      A,X     Get X coord.
        ADC             Add offset to base address
        LM              Get byte
        LR      VX,A    Save byte into VX reg
        NOP
       NOP
       NOP
       NOP
       PI     WAUD    WAIT, THEN UPDATE
       PI     ENIN    ENABLE INTERRUPT DRIVEN UPDATE
       PI     POPS    POP RETURN ADDRESS
       PK             AND RETURN
*-*-*-*-*-*-*-*-*-*-*-*-*-*-
*Data for byte values (X coord. conversions)
*
BYDT    DC      H'0880'
        DC      H'0440'
        DC      H'0220'
        DC      H'0110'
*-*-*-*-*-*-*-*-*-*-*-*-*-*-
*MVC*-*SET CURSOR, OR REMOVE IT
*
*USES R0,Q,SP23-24
*
MVC    LR     K,P     SAVE RETURN ADDRESS
       DCI    XPOS
       LM
       LR     0,A     SAVE X IN R0
       LISU   2
       LISL   3
       LM
       LR     I,A
       LM
       LR     D,A     LEAD IN SP23,TRAIL IN SP24
      CI    YPOS
       LM             GET Y COORDINATE
       DCI    H'0C30' DCO TO OBJ0 BASE ADDRESS
       ADC            ADD 8 X Y COORD (W/MAX FOR Y
       ADC            OVER H'40', CANNOT USE "CUTE"
       ADC            TRICKS HERE--AND FOR SPEED,
       ADC            WE JUST USE STRAIGHT ADC'S).
       ADC
       ADC
       ADC
       ADC
       LR     A,0     GET X OFFSET
       ADC            AND ADD IT IN
       LIS    CHT
       LR     0,A    SET COUNT FOR TRANSFER
MVC1   LR     Q,DC    SAVE ADDRESS IN Q REG
       LR     A,QU    GET HO ADDRESS
       CI     H'E'
       BNZ    MVC2    AT BOTTOM OF OBJ0
       LR     A,QL    DEFINITELY.
       CI     H'F'
       BC     MVC2    PAST BOTTOM?
       LIS    H'F'    YES.
       LR     QU,A    RESET HO ADDRESS
       LR     DC,Q    AND RESET DCO ACCORDINGLY (FOR OBJ1)
MVC2   LR     A,I     GET LEAD MASK BYTE
       LR     Q,DC    SAVE DCO
       XM             XOR IN CURSOR
       LR     DC,Q    RECOVER ADDRESS
       ST             AND RESET THAT BYTE
       LR     Q,DC    SAVE ADDRESS AGAIN
       LR     A,D     GET TRAILING MASK BYTE
       XM             XOR IN BITS
       LR     DC,Q    RECOVER ADDRESS
       ST             AND RESET DATA
       LIS    H'6'
       ADC            SET TO NEXT DESTINATION
       DS     0      DECREMENT COUNTER
       BNZ    MVC1    DONE?
       PK             YES, RETURN
*
*-*-*-*-*-*-*-*
*MAPPING OF JOYSTICK READINGS TO VELOCITIES
*
AMAP   LR   A,0     GET READING
       CI   H'2'
       BNC  AMP1    VAL LE H'1'?
       LI   H'FF'   YES.
       BR   AMP2
AMP1   CI   H'C6'
       CLR
       BC   AMP2    VAL GT 197?
       LIS  H'1'    YES, VELOCITY = 1
AMP2   POP          RETURN
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
* WRITE MESSAGE, CHECKERS
*MESSAGE NUMBER IN REGISTER 0
*USES R0, R1, SP O'24', AND THOSE REGISTERS
*USED BY THE UPDATE ROUTINE
*
WMC     LR      K,P     SAVE RETURN ADDRESS
        PI      PUSH    PUSH ONTO STACK
        PI      DAI     DISABLE INTERRUPTS
        DCI     HSAV
        LR      A,HU
        ST
        LR      A,HL
        ST
        PI      WAUD    WAIT, THEN UPDATE
        DCI     WMCA    DCO TO MESSAGE ADDRESS START
        LR      A,0     GET MESSAGE NUMBER
        SL      1
        AS      0
        ADC             ADD 3XNUMBER TO DCO
        LISU    2
        LISL    4       SET ISAR TO O'24'
        LM
        LR      S,A     SET MESSAGE LENGTH
        LM
        LR      QU,A
        LM
        LR      QL,A    MESSAGE ADDRESS INTO Q
        DCI     LINE
        LI      H'50'
        ST              SET PROPER LINE NUMBER
        DCI     H'0E5F' DCO TO MESSAGE BUILD AREA
        LI      H'70'
        LR      1,A     SET COUNTER
        CLR             CLEAR ACC
WMC1    ST
        DS      1
        BNZ     WMC1    CLEAR TEXT AREA
        PI      WAUD    WAIT, THEN DO UPDATE
        DCI     H'872'
        LIS     H'2'
        ST              TURN OBJECT ON
        LR      DC,Q    SET ADDRESS INTO DCO
        PI      WMS     WRITE MESSAGE
        PI      WAUD    WAIT, THEN UPDATE
      LR    A,0       Get message #
      CI    H'5'
      BP    WMC2      Does not require #
      LR    A,HL
      SR    4
      LR    TEMP,A
      PI    WDG       Write single digit
WMC2  PI    WAUD
      DCI   HSAV
      LM
      LR    HU,A
      LM
      LR    HL,A
        PI      ENIN    ENABLE INTERRUPTS ONCE MORE
        PI      POPS    POP RETURN ADDRESS
        PK              AND RETURN
*-*-*-*-*-*-*-*-*-*
* DATA FOR WMC
*
WMCA    DC      H'A'    YOUR MOVE!      0
        DC      YRMV:       
        DC      YRMV.
        DC      H'A'    MUST JUMP       1
        DC      MJM:
        DC      MJM.
        DC      H'D'    ILLEGAL MOVE    2
        DC      MIM:
        DC      MIM.
        DC      H'8'    TOO FAR         3
        DC      TFM:
        DC      TFM.
        DC      H'7'   MY MOVE             4
         DC     MYMV:
         DC     MYMV.
        DC      H'10'   PIECE CANNOT MOVE  5
        DC      PCMM:
        DC      PCMM.
       DC      H'5'     SELE             6
       DC      SELM:
       DC      SELM.
       DC      H'5'     SELY             7
       DC      SELY:
       DC      SELY.
       DC      H'5'     FIND             8
       DC      FINM:
       DC      FINM.
YRMV    DC      H'0513' YOur move
        DC      H'0309' UR
        DC      H'0'    SPACE
        DC      H'2913' MO
        DC      H'2F0B' VE
        DC      H'04'   !
MJM     DC      H'290B' MUst jump
        DC      H'2107' ST
        DC      H'0'    SPACE
        DC      H'1703' JU
        DC      H'2925' MP
        DC      H'04'   !
MIM     DC      H'0127' ILlegal move
        DC      H'270B' LE
        DC      H'1B11' GA
        DC      H'2700' L SPACE
        DC      H'2913' MO
        DC      H'2F0B' VE
        DC      H'04'   !
TFM     DC      H'0713' TO far
        DC      H'1300' O SPACE
        DC      H'1D11' FA
        DC      H'0904' R!
MYMV    DC      H'2905' MY move
         DC     H'0'     -
        DC      H'2913' MO
        DC      H'2F0B' VE
PCMM    DC      H'2501' PIece can't move
        DC      H'0B31' EC
        DC      H'0B00' E SPACE
        DC      H'3111' CA
        DC      H'2B39' N'
        DC      H'0700' T SPACE
        DC      H'2913' MO
        DC      H'2F0B' VE
SELM    DC      H'210B'  SEle
       DC      H'270B'  LE
       DC      H'0'     -
SELY    DC      H'210B'  SEly
       DC      H'2705'  LY
       DC      H'0'     -
FINM   DC      H'1D01'   FInd
       DC      H'2B1F'   ND
       DC       H'0'     -
*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*--
CONV CLR
     LR   3,A
     LR   A,2     Y, 0 thru 63
     AS  1        X, 0 thru 63
CNN2 CI  H'11'    Less than 18?
     BP  CNN3     X+Y in 3, 0 thru 6
     AI  H'6C'    Subtract 18
     DS  0
     BR  CNN2
CNN3 LR  A,2
     COM
     INC
     AS  1
     SL  4       Divide by 16
     LR  4,A     X-Y in 4, -7 thru 6
     AS  3
     SR  1       Divide by 2
     LR 1,A      Normalized X
     LR  A,4
     COM
     INC
     AS  3
     AI  H'7'
     SR  1
     LR  2,A     Normalized Y
     DCI  COL0
     LM
     NI  H'FF'
     BZ  CNN4
     LR A,1
     COM
     INC
     AI  H'8'
     LR 1,A      X, corrected for COL0
     LR  A,2
     COM
     INC
     AI  H'8'
     LR 2,A      Y, corrected for COL0
CNN4  NOP
*
*BLINK CODE GOES HERE
BLNK  LR        K,P
        DCI     BLNF    Test BLINK flag
        CLR
        XM
        BZ      BLN4    Need to blink?
        LISU    2
        LISL    3
        LM              Yes
        LR      I,A     Get X value
        LM
        LR      D,A     and Y value to blink
        DCI     COL0
        CLR
        XM
        BZ      BLN0    Need to reverse?
        LIS     H'7'
        XS      S
        LR      I,A
        LIS     H'7'
        XS      S
        LR      D,A
BLN0    DCI     H'0C30'-H'50'    DC0 TO OBJ0-H'50'
        LISL    4
        LIS     H'5'
        SL      4
BLN1    ADC                      Add off-set
        DS      S
        BP      BLN1            Added enough?
        LR      Q,DC            Yes
        LR      A,QU            Get H0 address
        CI      H'E'
        BNZ     BLN2            Need reset?
        LIS     H'F'            Yes
        LR      QU,A
BLN2    LR      DC,Q
        LISL    3
        LR      A,S
        ADC                     Add off-set
        LIS     H'3'
        LR      0,A             Set counter
BLN3    LR      Q,DC
        LI      H'C0'
        XM
        LR      DC,Q
        ST
        LIS     H'7'
        ADC                     Next one to blink
        DS      0               Decrement counter
        BNZ     BLN3            Done?
BLN4    PK
*
       ORG     H'1680'
*
*-*-*-*-*-*-*-*-*-*
*   INHR  INTERRUPT HANDLER
*
*   STORES ENVIRONMENT BEFORE CALLING UDAT
*   AND RESTORES BEFORE GOING BACK'
*
INHR   LR      8,A     SAVE ACC
       LR      A,IS
       LISU    O'6'
       LISL    O'0'
       LR      I,A     SAVE A IN REG24
       LR      A,QU
       LR      I,A     SAVE QU IN REG25
       LR      A,QL
       LR      I,A     SAVE QL IN REG26
       LR      A,J
       LR      I,A     SAV IN REG27
       XDC
       LR      Q,DC    GET DC
       DCI     H'0FB0' GET FREE RAM ADDR.
       LR      A,QU    SAVE ORIGINAL DC1
       ST
       LR      A,QL
       ST
       XDC
       LR      Q,DC
       XDC
       LR      A,KU
       ST
       LR      A,KL
       ST              SAVE KL
       LR      A,HU    UPPER H
       ST              SAVE IT
       LR      A,HL
       ST              SAVE H
       LR      J,W
       LR      A,J
       ST              SAVE W
       LR      K,P
       LR      A,KU
       ST              SAVE PCU
       LR      A,KL
       ST              SAVE PCL
       LR      A,QU    SAVE DC0 ORIGINAL
       ST
       LR      A,QL
       ST
       PI      UDAT    UPTE DISPLAY
*
*   RESTORE ALL REGISTERS
*
       DCI     H'0FB0'
       LM
       LR      QU,A    GET DC1
       LM
       LR      QL,A
       XDC
       LR      DC,Q    RESTORE DC1
       XDC
       LIS     H'2'
       ADC             BYPASS 'K' SAVED AREA
       LM              GET HU
       LR      HU,A    RESTORE HU
       LM
       LR      HL,A    RESTORE HL
       LM              GET W
       LR      J,A
       LR      W,J     RESTORE IT
       LM              GET PC1 HO
       LR      KU,A
       LM
       LR      KL,A
       LR      P,K     RESTORE PC1
       LM
       LR      QU,A
       LM
       LR      QL,A
       DCI     H'FB2'        PT TO K
       LM              GET KU
       LR      KU,A
       LM
       LR      KL,A    RESTORE K
       LR      DC,Q    RESTORE DC0
*
*   NOW RESTORE J,Q,A FROM SCRATCH PAD
*
       LISU    O'6'
       LISL    O'3'
       LR      A,D     GET J
       LR      J,A
       LR      A,D   GET QL
       LR      QL,A
       LR      A,D
       LR      QU,A    RESTORE QU
       LR      A,D     GET ISAR
       LR      IS,A    RESTORE ISAR
       LR      A,8     RESTORE A
       EI              INT. ENABLE
       POP
*   DISAY YOU MOVE FIRST?
*             Y OR N
*
*
YMF    DC      H'0513' Y0
       DC      H'0300' U-
       DC      H'2913' MO
       DC      H'2F0B' VE
       DC      H'00'   -
       DC      H'1D'   F
       DC      H'0109' IR
       DC      H'2107' ST
       DC      H'00'   -
       DC      H'35'   ?
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'0500' Y-
       DC      H'1309' OR
       DC      H'00'   -
       DC      H'2B'   N
*   INIT  DATA
INIT   DC      H'30'   OBJ0 L.O.RP
       DC      H'10'   OBJ1 L.O. RP
        DC      H'5F'   TEXT LOW ORDER ROM
       DC      H'8C'   OBJ0 H.O.RP+COLOR
       DC      H'8F'   OBJ1    H.O.RP
        DC      H'EE'   
       DC      H'48'   OBJ0 DELTA X ---
       DC      H'48'   OBJ1 DELTA X---
       DC      H'70'   TEXT OBJECT DELTA X
TY0   DC      H'3C'   OBJ0 DELTA Y ----
       DC      H'14'  OBJ1 DELTA Y ---
       DC      H'07'  TEXT OBJECT DELTA Y
       DC      H'0D'   OBJ0-X-CO
       DC      H'0D'   OBJ1 X-CO
       DC      H'0D'   TEXT OBJECT X COORD
       DC      H'48'   OBJ0 Y-VALUE L.O.A
       DC      H'C0'   OBJ1 Y-VALUE L.O.A
       DC      H'26'   TEXT OBJECT Y VAL LO A
       DC      H'00'   OBJ0 Y-VALUE H.0 &X-ORDER
       DC      H'01'   OBJ1- Y-VAL H.O.$X-ORDER
       DC      H'82'   TEXT OBJ INITIALLY OFF
UDIT   DC      H'30'
       DC      H'10'
       DC      H'5F'
       DC      H'8C'
       DC      H'8F'
       DC      H'EE'
        DC      H'3C'
        DC      H'14'
        DC      H'07'
TAB1   DC      H'0F10' BYTE 3
       DC      H'0D70' BYTE 2
       DC      H'0CD0' BYTE 1
       DC      H'0C30' BYTE 0
TAB2   DC    D'86'   RELATIVE SQUARE POSITION TABLE
       DC      D'84'
       DC      D'82'
       DC      D'80'
       DC      D'07'
       DC      D'05'
       DC      D'03'
       DC      D'01'
KING   DC      B'011010'     KING'S CROWN
       DC      B'00111100'
       DC      B'00011000'
REDP   DC      B'00111100'     RED PIECE
       DC      B'01111110'
       DC      B'01111110'
       DC      B'01111110'
       DC      B'00111100'
BLKP   DC      B'00111100'     BLACK PIECE
       DC      B'01000010'
       DC      B'01000010'
       DC      B'01000010'
       DC      B'00111100'
POIN   DC      B'00001100'
       DC      B'00000110'
       DC      B'00000011'
       DC      B'00000001'
*-*-*-*-*-*-*-*-*-*-*-*-*-
*   SKILL LEVEL TEXT TABLE
*
SKL    DC      H'3119' CH
       DC      H'1313' OO
       DC      H'210B' SE
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'150B' KE
       DC      H'0500' Y-
       DC      H'00'   -
       DC      H'00'   -
       DC      H'0713' TO
       DC      H'2900' M-
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'07'   T
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
DICK   DC      H'1F01' DI
       DC      H'3115' CK
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'1F'   D
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
HARY   DC      H'1911' HA
       DC      H'0909' RR
       DC      H'0500' Y-
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'19'   H
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
       DC      H'00'   -
* FKT  GMEN  RFJN  LFJN  STMV
*-*-*-*-*-*-*-*-*-*-*-*-*-
* limits pieces to KINGS depending on direction and color
*
FKT     LR      K,P
        CLR
        AS      7
        BR      FK1
BKT     LR      K,P
        LR      A,7             Test sides for backward move
        COM
FK1     BZ      FK2             NORMAL pieces can move
        LISU    KLOC            KINGS only can move
        LR      A,S
        NS      3
        LR      3,A
        BZ      FK3             No RF OR LF moves from this byte
FK2     LR      A,3
        NS      3               To set status
FK3     PK
*
FJET    LR      K,P
        LIS     H'1'
        BR      BJE2
BJET    LR      K,P
        LI      H'FF'
BJE2    AS      4
        AI      ISE
        LR      IS,A
        LR      A,S
        PK
*
*Subroutine to get byte of ACTIVE pieces
GMEN    LR      K,P
        LISU    PLOC
        LISL    0
        LR      A,IS
        AS      4               Add byte #
        LR      IS,A            Get to initial byte
        LR      A,6
        CI      H'7'            Is this an attempted continuation?
        BZ      GME2            Yes, 3 is already set
        CI      H'1'            Maybe back up to test for forked continuation
        BZ      GME2
        LR      A,S
        LR      3,A
GME2    PK
*
*Subroutine used both by RFJ and RFN
RFJN    LR      K,P
        LR      A,I
        SL      4
        LR      0,A
        LR      A,S
        SR      4
        SR      1
        AS      0
        NS      3
        LR      3,A             The RFJ or RJ byte
        PK
*
*Subroutine used both by LFJ and LFN
LFJN    LR      K,P
        LR      A,I
        SL      4
        SL      1
        LR      0,A
        LR      A,S
        SR      4
        AS      0
        NS      3
        LR      3,A             The LFJ or LFN byte
        PK
*
*Subroutine used both by LBJ and LBN
LBJN    LR      K,P
        LR      A,D
        SL      4
        LR      0,A
        LR      A,S
        SR      4
        SR      1
        AS      0
        NS      3
        LR      3,A
        PK
*
*Subroutine used both by RBJ and RBN
RBJN    LR      K,P
        LR      A,D
        SL      4
        SL      1
        LR      0,A
        LR      A,S
        SR      4
        AS      0
        NS      3
        LR      3,A
        PK
*Subroutine to add to MOBILITY, and to store MOVE and FLAG bytes if necessary
STMV    LR      K,P
        LISU    KLOC
        LISL    4               To MOVE byte
        LR      A,3             GET newly computed MOVE byte
        LR      0,A
        PI      CAQ             Count its bits
        AS      2               Add earlier counts
        LR      2,A             and store
        LR      A,HL
        SR      4
        CI      H'01'           Is this the player's board
        BNZ     STM3            No
        DCI     PLMV            Player's moves stored separately
STM0    LM
        NI      H'FF'
        BZ      STM1            Find empty space
        LM                      Skip info space
        BR      STM0            Try again
STM1    LI      H'FF'           Back up
        ADC
        LR      A,3
        ST
        LR      A,4
        SL      1
        SL      1
        AS      5
        ST
        CLR
        ST                      Store 0 as stop
        PK
STM3    LR      A,S             Has a move byte been stored?
        NS      S               To set status byte
        BNZ     STM2            One is already stored
        LR      DC,H            Get back in step (may not be necessary)
        LIS     H'C'            To get to MOVE byte
        ADC
STM4    LR      A,3
        ST                      Store MOVE byte in RAM
        LR      I,A             Also put it in SC record as a flag
        LR      A,4             Get the byte pointer
        SL      1
        SL      1
        AS      5
        ST                      Put this into RAM
        LR      DC,H            May be necessary
STM2    PK
* NEXT  FIND  RFJ  LFJ  RBJ  LBJ
*
NEXT    CLR
        LR      6,A             Set for normal back up
        LR      DC,H
        LIS     H'D'            Get to byte number info
        ADC
        LR      A,HL            Check for multiple jump condition
        SR      4
        AI      H'FD'           1 for start offset, 2 ply's Mobs. not saved
        BM      NEX2            Can not be a continuation
        XDC                     Save location
        DCI     MOBS
        ADC
        LM
        NI      H'7'            Is flag set?
        XDC
        BZ      NEX2            No multiple jump
*The moving piece byte and byte number is stored in the next earlier block
        XDC
        LR      DC,H
        LI      H'FC'           Back up to get info
        ADC
        LM
        LR      3,A             The byte with 1 bit on
        LM
        LR      4,A             The byte number
        XDC                     Now back again to the current block
        LIS     H'1'            The signal read by GMEN
        LR      6,A             Overwrite previously set value
NEX2    LM                      Get identifying data
        LR      0,A             Save temporarily
        NI      H'F'            Leave J bit and other data off
        CI      H'F'            Is this the last move byte?
        BZ      NEX5            Yes
        LR      A,0
        INC                     To next  direction
        LR      0,A
        SR      1
        SR      1
        NI      3
        LR      4,A             Save byte number
        LR      A,0             Now get the direction
        NI      3               Separate out desired data
        LR      5,A             And save  (it will be a 1, 2, or 3)
        LR      A,0
        NI      H'10'           Check jump bit
        BNZ     NEX4            A jump move
        LR      A,5
        NS      5
        BZ      NEX3
        JMP     RBN0            A normal move, decide on 1, 2, or 3 later
NEX3    JMP     RFN             It was 0
NEX5    JMP     AFT
NEX4    LR      A,5
        NS      5
        BZ      RFJ             It was a 0
        CI      H'2'            Which direction, 1, 2, or 3?
        BM      LBJ             It was a 3
        BNZ     LFJ             It was a 1
        BR      RBJ             It was a 2
*We enter here on going forward
FIND    LIS     H'8'        TEMP INST TO DEBUG
        LR      0,A
        PI      WMC
FIN1    BR      FIN1
        NOP
        NOP
        LR      DC,H
        PI      RASC
        LISU    PLOC
        LISL    0               Start with byte 0
        CLR
        LR      4,A             Used to distinguish byte
        LR      2,A             Used to accumulate mobility count by STMV
        LI      H'FF'
        LR      6,A             So all moves will be found
RFJ     PI      GMEN
        PI      FKT             Are there forward moving pieces?
        PI      FJET            Are jump moves in this direction posible?
        SR      1
        NI      H'77'           Save 6 particular bits only
        NS      3
        LR      3,A             Only pieces that have place to land
        LR      A,IS
        AS      4
        LR      IS,A
        PI      RFJN            This returns the RFJ byte in 3 and sets STATUS
        BZ      LFJ
        LI      H'10'           The RFJ direction and J indicator
        LR      5,A
        PI      STMV            Store MOVE and FLAG if MOVE found
        BR      JUMF
LFJ     PI      GMEN
        PI      FKT
        PI      FJET            Are jump moves in this direction posible?
        SL      1
        NI      H'EE'           Save 6 particular bits only
        NS      3
        LR      3,A             Only pieces that have a place to land
        LR      A,IS
        AS      4
        LR      IS,A
        PI      LFJN            This returns the LFJ byte in 3
        BZ      RBJ
        LI      H'11'           The LFJ direction and J indicator
        LR      5,A
        PI      STMV
        BR      JUMF
RBJ0    LR      A,5
        CI      H'2'            Which direction, 1, 2, or 3?
        BM      LBJ             It was a 3
        BNZ     LFJ             It was a 1
RBJ     PI      GMEN
        PI      BKT
        PI      BJET
        SR      1
        NI      H'77'           Save 6 particular bits only
        NS      3
        LR      3,A
        LR      A,IS
        AS      4
        LR      IS,A
        PI      RBJN            This returns the RBJ byte in 3
        BZ      LBJ
        LI      H'12'           The RBJ direction and J indicator
        LR      5,A
        PI      STMV
        BR      JUMF
LBJ     PI      GMEN
        PI      BKT
        PI      BJET
        SL      1
        NI      H'EE'           Save 6 particular bits only
        NS      3
        LR      3,A
        LR      A,IS
        AS      4
        LR      IS,A
        PI      LBJN            This returns the RBJ byte in 3
        BZ      JUMT
        LI      H'13'           The RBJ direction and J indicator
        LR      5,A
        PI      STMV
JUMF    LR      A,HL            Where are we?
        SR      4               To get the ply
        CI      H'1'            Remember offset
        BNZ     JUMD
        JMP     PMRT            Check players move for validity
JUMD    CI      H'F'            Are we out of space? (next block contains MOBS)
        BZ      RFN             To compute non-jump mobility and stop anyway
        JMP     SELE
* JUMT AFTC
*
*No move found from this byte so see if there are more bytes
JUMT    LR      A,6
*Are we backing up and then trying to find yet another continuation?
        CI      H'1'            Are we backing up to a possible fork
        BZ      AFTC            Yes so something special is required
        CI      H'7'            Were we trying to find a continuation
        BNZ     JUMM            No
        LR      DC,H            There was no continuation
        LI      H'F0'           Back up
        ADC
        LR      H,DC
        JMP     DOUX            This changes the color and proceeds
JUMM    LR      A,4
        INC
        NI      H'3'
        LR      4,A
        BNZ     RFJ             Go round again for next byte
        LR      A,6
        XI      H'FF'
        CLR
        LR      4,A             Prepare to start over on the first byte
        BZ      RFN             Maybe there are normal moves
        JMP     AFT             A jump was demanded so back up
*We compare the score with that 2 blocks earlier and back it up if greater
*and then back to this level in any case
AFTC    LR      DC,H            We are here
        LIS     H'E'            Get score values
        ADC
        LM
        LR      0,A             Save them to complare
        LM
        LR      1,A
        LI      H'D0'           Actually backing only 2
        ADC
        LR      H,DC            We back up always
        LIS     H'E'            Get to score location
        ADC
        LR      A,0             Now compare score
        CM
        BM      AFT2            Back score for sure
        BNZ     AFT5            Do not back score
        LR      A,1             A further comparison is necessary
        CM
        BP      AFT5            Do not back after all
AFT2    LR      DC,H            Resetting is easier
        LIS     H'E'
        ADC
        LR      A,0             Back up the score
        ST
        LR      A,1
        ST
        LR      A,HL            Where are we?
        SR      4
        CI      H'3'            Do we need to save board as possible move?
        BNZ     AFT5            No, at some other level in the tree
        LR      A,0             Invert score for compaarison
        COM
        INC
        LR      0,A
        LR      A,1             Invert score
        COM
        INC
        LR      1,A
        LR      DC,H
        LI      H'FE'           Back to earlies score
        ADC
        LR      A,0
        CM
        BM      AFT3            Board should be saved
        BNZ     AFT5            It should not be saved
        LR      A,1
        CM
        BP      AFT5            Don't save after all
*Special treatment is necessary to prevent the saving of the
*intermediate board position of the multiple jump at a later time
*We do this by backing the score now
AFT3    LR      DC,H
        LI      H'FE'
        ADC
        LR      A,0             First back score now
        ST
        LR      A,1
        ST
        DCI     TREE            Location to save board
        XDC
*
*NOTE: This is fixed for a double jump but some additional code
*may still needed for a triple jump!
*
        LR      DC,H
        LI      H'10'           Double jump resulting board
        ADC
        LR      0,A             Counter
AFT4    LM                      Now save the board
        XDC
        ST
        XDC
        DS      0
        BNZ     AFT4
AFT5    JMP     SELE
* AFT MAKE OKMV PMRT
*
*No moves found so time to back up
AFT     LR      DC,H
        LIS     H'E'            Get to SCORE
        ADC
        LM
        LR      0,A             The current material advantage term
        LM
        LR      6,A             The current positional term
        LR      A,HL            Where are we?
        SR      4
        CI      H'2'
        BZ      MAKE            Time to report move
        CI      H'3'            Room to alpha-beta prune?
        BP      AFTX            No
        LR      DC,H
        LI      H'EE'           The score for 2 boards earlier
        ADC
        JMP     EV4A
AFTX    JMP     EVA5
*
*Prepare for analysis of player's reply
MAKE    DCI     TREE            Get to players board
        LR      H,DC
        XDC                     Now clear space for possible players moves
        DCI     PLMV            This space is also used by TREE routine
        LIS     H'F'
        LR      0,A
        CLR
        ST
        DS      0
        BP      *-2
        XDC
        JMP     FIND
*Subroutine to save players possible moves
SVPM    LR      K,P
        XDC                     So we can get back
        LR      A,5
        NI      H'10'
        DCI     PLMF            Players jump move flag
        ST
        LR      A,4
        SL      1
        SL      1
        AS      5
        NI      H'F'            Save only last 4 bits
        DCI     PLMV            This area may be overwritten by tree info.
        ADC
        LR      A,3
        ST
        XDC
        PK
PMRT    NOP                     Player's possible moves have been listed
*We are ready to display the new board
*-*- DISPLAY CODE GOES IN HERE

*We are ready to verify players move
OKIT    DCI     PLMV            Location where players move began
*-*- INIT JOYSTICK and wait for players indication that he has picked
*-*piece to move then go to OKPI and then to OKMV
* RFN LFN RBN LBN NORT NORF NOR2 NOR3 NOR4
*
RFN     PI      GMEN
        PI      FKT
        BZ      RBN
        LR      A,4             Get byte number
        AI      ISE             Start of empty region
        LR      IS,A
        PI      RFJN
        BZ      LFN
        CLR
        LR      5,A
        PI      STMV
        LR      A,6
        XI      H'FF'
        BNZ     NORF
LFN     PI      GMEN
        PI      FKT
        BZ      RBN
        LR      A,4             Get byte number
        AI      ISE             Start of empty region
        LR      IS,A
        PI      LFJN
        BZ      RBN
        LIS     H'1'
        LR      5,A
        PI      STMV
        LR      A,6
        XI      H'FF'
        BNZ     NORF
        BR      RBN
RBN0    LR      A,5
        CI      H'2'            Which direction, 1, 2, or 3?
        BM      LBN             It was a 3
        BNZ     LFN             It was a 1
RBN     PI      GMEN
        PI      BKT
        BZ      NORT
        LR      A,4             Get byte number
        AI      ISE             Start of empty region
        LR      IS,A
        PI      RBJN
        BZ      NORT
        LIS     H'2'
        LR      5,A
        PI      STMV
        LR      A,6
        XI      H'FF'
        BNZ     NORF
LBN     PI      GMEN
        PI      BKT
        BZ      NORT
        LR      A,4             Get byte number
        AI      ISE             Start of empty region
        LR      IS,A
        PI      LBJN
        BZ      NORT
        LIS     H'3'
        LR      5,A
        PI      STMV
        LR      A,6
        XI      H'FF'
        BZ      NORT
NORF    JMP     SELE
*We get here if we want to compute mobility and also if no moves found
NORT    LR      A,4
        INC
        NI      H'3'
        LR      4,A
        BNZ     RFN             Go round again for next byte
        LR      A,2             Get mobility count
        NS      2
        BNZ     NOR1
        JMP     AFT             Woops! no move found
NOR1    LR      A,HL            Where are we?
        SR      4               Get Ply number
        AI      H'FF'
        LR      3,A
        BNZ     NOR2
        JMP     PMRT            Ckeck players move for validity
NOR2    DCI     PLY0            Player's choice of ply
        CM
        LR      DC,H            Reset DC
        BM      NOR3            Stop for sure
        BNZ     NOR4            Go on in this case
        LI      H'F5'           Decision based on previous move
        ADC
        LM
        NI      H'10'           Test jump flag
        LR      DC,H
        BNZ     NOR4            Go on if previous move was a jump
NOR3    JMP     EVAL
NOR4    LR      A,3
NOR5    AI      H'FD'           To save space so MOBS will not overflow
        BM      NOR7            Don't save mobility for early plys
        DCI     MOBS
        ADC
        LR      A,2
        CI      H'F'            Limit mobility to 15 so it will pack
        BP      NOR6
        LIS     H'F'
NOR6    SL      4               Reserve right half for Multiple jump flags
        ST                      Save mobility in MOBS space indexed by ply
NOR7    JMP     SELE
* SELECT  SELE
*
*SELECT branches to NEXT if MOVE is empty, or it extracts the rightmost
*bit from the MOVE byte in RAM, storing the extracted bit in SC 6, puts the
*FLAG byte in SC 7, the byte number in 4, and the J and direction bits in 5.
*and proceeds to make the selected move.
SELE    NOP
        NOP
        NOP
        NOP
        LR      DC,H
        PI      RASC            Get board data into Scratchpad
SEL2    NOP
        NOP
        NOP
        NOP
        LISU    PLOC
        LISL    0
        LR      DC,H
        LIS     H'C'            To get MOVE byte
        ADC
        LM
        LR      0,A             Save it temporarily
        NS      0               To set status byte
        BNZ     SEL3
        JMP     NEXT            To get next MOVE byte
SEL3    LI      H'FF'
        ADC                     Get back to move byte
        LR      A,0
        AI      H'FF'           Really subtracting 1
        NS      0               Remove right-most on-bit
        ST                      Put remaining bits back (and index)
        XS      0               This gets the extracted bit
        LR      6,A             Save it in 6
*-*- A record of the serial number of this move should be kept for ply 0
*-*- and put with the resulting board, for use in identifying path for book moves.
        LM                      Now get the byte designation
SEL4    LR      5,A
        SR      1
        SR      1
        NI      H'3'            Separate the byte indicator part
        LR      4,A             Save it in 4
        LR      A,5
        NI      H'13'           Separate the JUMP bit and the direction
        LR      5,A             Save them in 5
*Now process ACTIVE and KINGS for source deletion
DELE    PI      GMEN
        LR      A,3
        XS      6               Delete moving piece
        LR      S,A             from byte
        LISU    KLOC            To get to corresponding KING byte
        LR      A,S
        NS      6               Was the piece a king?
        BZ      DEL2
        XS      S               If it was delete king bit
        LR      S,A
        LIS     H'7'            Non-zero in 2 for king 
DEL2   LISU  PLOC
   LR  2,A
*Now locate captured piece if jump or find destination in normal move
        LR      A,6             Recall MOVE bit
        SR      4
        BZ      INRH            Bit was in right half of byte
INLH    LR      3,A             Save partially shifted MOVE bit
        LR      A,5             Get direction
        NI      H'1'            To test right-most bit
        BZ      INL2            RF or LB move where 4 shift is correct
        LR      A,3
        SR      1               LF and LB require an additional shift
        LR      3,A
INL2    LR      A,5             Now test for fore or aft
        NI      H'2'
        BZ      BOTH            Forward move, no byte shift needed
        LR      A,D             Only to decrement ISAR
INL3    BR      BOTH
*
INRH    LR      A,6             Get MOVE bit again
        SL      4               Left shift if in right half
        LR      3,A             Save partially shifted MOVE bit
        LR      A,5             Get direction
        NI      H'1'
        BNZ     INR2            LF or RB wwhere 4 shift is correct
        LR      A,3
        SL      1               RF and RB require an additional shift
        LR      3,A
INR2    LR      A,5             Now test fore and aft
        NI      H'2'
        BNZ     BOTH
        LR      A,I             Only to increment ISAR
*Now we are ready to decide if jump or not
BOTH    CLR
        LR      0,A             Used temporarily to accumulate piece debit
        LR      A,5             Now is this a jump or a normal move?
        SR      4
        BNZ     BOT1
        JMP     NORM            It's a normal move
BOT1    JMP     JUMP
* JUMP
*
JUMP    LR      A,S             Get King Byte corresponding to captured piece
        NS      3               Was piece a king?
        BZ      JUM1            No
        XS      3               Delete it
        LR      S,A             And replace byte
        LR      A,0
        INC                     Count 1 extra for king
        LR      0,A
JUM1    LIS     H'2'
        AS      0               Count 2 for piece capture
        LR      0,A
        LISU    PLOC            Get back to right buffer for ACTI and PASS
        LR      A,IS
        AI      4               Increment to PASSIVE byte
        LR      IS,A
        LR      A,S             Get appropiate PASSIVE byte
        XS      3               Delete capture
        LR      S,A             And return byte
        LISU    PLOC            Back to moved-from location
        LISL    0
        LR      A,IS
        AS      4               Byte number is in 4
        LR      IS,A
        LR      A,5             Get direction
        NI      H'1'            Test for right or left
        BZ      JUM2            
        LR      A,6             It's to the left
        SR      1               Left moves involve a right shift of 1
        BR      JUM3
JUM2    LR      A,6             It's to the right
        SL      1               Right moves involve a left shift of 1
JUM3    LR      3,A             Save displaced bit in 3
        LR      A,5
        NI      H'2'            Test for fore or aft
        BZ      JUM4            Fore move
        LR      A,D             Decrement ISAR (destination always in next byte)
        LR      A,4
        AI      H'FF'           Correct to destination byte number
        LR      A,2             Was the piece a king?
        NS      2
        BNZ     JUM6            Yes, so not necessary to test for a promotion
        LR      A,IS            Backward non-king must be white
        CI      O'30'           Is this WHITE's king row
        BNZ     JUM7            No, so there may still be a double jump
        BR      JUM5            Promotion indicated, so no double jump possible
JUM4    LR      A,I             Increment ISAR
        LR      A,4
        AI      H'1'            Correct to destination byte number
        LR      4,A             We'll need this for continuation
        LR      A,2             Was the piece a king?
        NS      2
        BNZ     JUM6            Yes, so not necessary to test for promotion
        LR      A,IS            Forward non-king must be black
        CI      O'33'           Is this BLACK's king row
        BNZ     JUM7            No, so there may still be a double jump
*Promotion indicated, do it and set 2 to flag bypass of double jump prepare
JUM5    LIS     H'1'            Non-zero (but not 7) for promotion
        LR      2,A             It is so promote piece
        LR      A,0
        INC                     Add 1 to debit account
        LR      0,A
JUM6    LR      A,S             Now get right byte
        AS      3               Insert piece
        LR      S,A
        LR      A,IS            Prepare to deposit king
        AI      7               Go to correct king byte
        LR      IS,A
JUM7    LISL    4               Get to piece debit position
        LR      A,S
        SR      4               Note that right part is zero'ed
        SR      1
        AS      0
        CI      H'7'            Limit size to 7
        BP      JU7M
        LI      H'7'
JU7M    SL      4
        SL      1
        LR      S,A
        LR      A,2     
        CI      H'1'            Was it by promotion?
        BZ      JUM9            It was, so no double jump prepare
*Now we must anticipate a forked double jump
*See the detailed explanation of multiple jumps on page 3.
        LR      DC,H            Do not advance H yet
        LI      H'20'           Copy data two blocks forward
        ADC
        LISU    PLOC
        LISL    0
        LIS     H'8'
        LR      0,A
        PI      SCRL            Active and passive pieces
        LISU    KLOC
        LISL    0
        LIS     H'4'
        LR      0,A
        PI      SCRL
        LIS     H'4'
        LR      0,A
        LR      Q,DC
        XDC
        LR      DC,Q
        LI      H'E0'           Last 4 bytes come from current RAM data
        ADC
JUM8    LM
        XDC
        ST
        XDC
        DS      0
        BNZ     JUM8
*Now save the board in anticipation of no double jump
JUM9    LR      DC,H            (Do not yet advance H)
        LI      H'10'
        ADC
        PI      SCRA
*Now look into double jump situation
        LR      A,2
        CI      H'1'            Was there a promotion?
        BNZ     DOUB            No, so may be a double jump
        LR      DC,H            Finally ready to advance H
        LI      H'10'
        ADC
        LR      H,DC
*We get here from FIND (with H reset) if no continuation possible
DOUX    LR      A,7
        COM
        LR      7,A
        JMP     FIND
DOUB    LR      DC,H            Advance H by 2
        LI      H'1C'
        ADC
        LR      A,3             Needed if continuation is successful
        ST                      It will be overwritten if not
        LR      A,4
        ST
        LR      DC,H
        LI      H'20'
        ADC
        LR      H,DC
        LR      A,HL
        SR      4
        XDC
        DCI     MOBS
        AI      H'FD'           stored back by 3
        ADC                     Will never be too early
        LIS     H'F'            Used to signal a continuation
        LR      6,A
        ST                      Set continuation signal
        XDC                     get back
        PI      RASC            Load scratchpad
        JMP     RFJ
* NORM  FORE
*
*Now make normal move
NORM    LISU    PLOC            Get back to Active pieces
        LR      A,S             LISL still OK
        AS      3
        LR      S,A             Put in moved piece
        LR      A,2             Was it a king
        NS      2
        BNZ     NOM6            Yes so don't promote but do put king down
        LR      A,5
        NI      H'2'            Test for direction
        BZ      NOM4            Black is active
        LR      A,IS
        CI      H'30'           Did it get to the white king row?
        BZ      NOM5            Yes, so promote
        BR      FORE
NOM4    LR      A,IS            Black is active
        CI      H'33'           Did it get to the king row?
        BNZ     FORE            No
NOM5    LIS     H'1'
        LR      0,A
NOM6    LISU    KLOC            Now get to king byte
        LR      A,S             Get corresponding king byte for destination
        AS      3               Insert king
        LR      S,A             And replace byte
        LR      A,0
        NS      0
        BZ      FORE
        LISL    4               Now fix the piece debit
        LR      A,S
        SR      4
        SR      1
        INC
        CI      H'7'
        BP      NOM7
        LI      H'7'
NOM7    SL      4
        SL      1
        LR      S,A
FORE    LR      A,7
        COM                Change color
        LR      7,A
        LIS     H'7'        TEMP INST TO DEBUG
        LR      0,A
        PI      WMC
        NOP
        NOP
        NOP
        NOP
        NOP
        DCI     SELX
        LM
        NI      H'FF'
        BZ      FOR2       Normal case
        NOP
        NOP
        NOP
        NOP
        NOP
        DCI     SELX       Special cases
        CLR
        XM
        DCI     SELX
        CLR
        BP      FOR1       Machine's first move
* Store player's move, report board and start machine play
        ST                 SELX set to 0
        PI      BORD       Redraw board
        PI      MEN        Put men back on
        NOP
        NOP
        NOP
        NOP
        NOP
        DCI     TRE2       Board for machine's move goes here
        LR      H,DC
        PI      SCRA       Reverse Active and Passive
        LR      DC,H
        PI      RASC
        LR      DC,H
        LI      H'4'       "MY MOVE"
        LR      0,A
        PI      WMC
        JMP     FIND
*Make machine's first (book) move
FOR1    COM                Player's move next
        ST                 SELX set to -1
        DCI     TREE       Machine's first move
        LR      H,DC
        PI      SCRA
        LR      DC,H
        PI      RASC
        NOP
        NOP
        NOP
        NOP
        NOP
        NOP
        PI      BORD       Redraw board
        PI      MEN        Put men back on
        NOP
        NOP
        NOP
        NOP
        NOP
        BR      *
        JMP     MAKE       Make and report move
*Normal going forward along tree
FOR2    LR      DC,H
        LI      H'10'
        ADC                     To next board record
        LR      H,DC
        PI      SCRA            Save newly created board record
        LR      H,DC
        PI      RASC
        JMP     FIND
* EVAL
*
EVAL    LR      A,HL            We'll need the ply value
        SR      4
        AI      H'FF'
        LR      5,A             We'll need it again
        AI      H'FD'           MOBS indexes 2 less and we want one earlier
        LR      DC,H
        ADC
        LM                      Get earlier mobility
        SR      4               It was shifted to pack
        COM
        INC
        AS      2               Add current mobility
        CI      H'7'            Difference limited to absolute 7
        BP      EVAA
        LI      H'7'
EVAA    CI      H'F9'
        BM      EVAB
        LI      H'F9'
EVAB    SL      4               Make room for ply term
        LR      6,A             Save difference (and free 2)
*Now look to the first term
        LR      DC,H            Make sure this is correct
        LIS     H'C'            To get current board piece debit
        ADC
        LISU    KLOC
        LISL    5               To  get previous board piece debit
        LR      A,I             
        SR      4
        SR      1
        LR      2,A             Piece credit for ACTIVE
        LM                      Now the current board
        SR      4
        SR      1
        LR      1,A             Piece credit for PASSIVE
        LR      0,A             Save it twice
        COM
        INC             Make it a true negation
        AS      2
        LR      4,A             Save for its sign
        BZ      EVA7            No material advantage
        BP      EVA2
        COM             
        INC             Make it a true negation
        LR      1,A
        LR      A,0             This was the larger
        LR      2,A
EVA2    LR      A,2
        AI      2               Increase larger by 2
        LR      2,A     
        PI      MPYR            Multiply  2 by 1
        LR      A,4
        NS      4
        BP      EVA3
        LR      A,0
        COM                     Note not true negation
        INC
        LR      0,A             The Piece score
        LR      A,5
        BR      EVA4
EVA3    LR      A,5
        COM
        INC
EVA4    AS      6               Add in the mobility term
        LR      6,A             Completed positional term
        LR      A,5
EV4A    CI      H'2'            Are we far enough along to be able to prune?
        BP      EVA5            No
EV4B    LR      A,0             Now get material advantage term back
        CM                      Compare with value brought forward 2 levels
        BM      EVA5            Can not alphe-beta prune
        BNZ     EVA9            In this case we can for sure
*We have to compare second score terms in this case
        LR      A,6
        CM
        BP      EVA9            We can prune
EVA5    LR      DC,H            Otherwise back 1 level
        LI      H'F0'
        ADC
        LR      H,DC
        LIS     H'E'
        ADC
        LR      A,0
        COM
        INC
        CM      
        BM      EVA6            Back score for sure
        BNZ     EVA8            Do not back score for sure
        LR      A,6
        COM
        INC
        CM
        BP      EVA8            Do not back score
EVA6    LR      DC,H
        LIS     H'E'
        ADC                     Get back to first score term
        LR      A,0
        COM
        INC
        ST
        LR      A,6
        COM
        INC
        ST
        LR      A,5             Where are we?
        CI      H'1'            (5 has already been decremented)
        BNZ     EVA8            Not going back to the first board
        LR      DC,H
        LI      H'F0'
        ADC
        XDC
        LI      H'20'
        ADC
        LI      H'10'           Prepare to save this board
        LR      0,A
EVA7    LM
        XDC
        ST
        XDC
        DS 0
        BNZ     EVA7
EVA8    JMP     SELE
EVA9    LR      DC,H
        LI      H'E0'           Back 2
        ADC
        LR      H,DC
        JMP     SELE
*
*Code to read stored book moves
*
BOOK    LR      K,P
        LISU    2
        LISL    5
        LR      A,S
        NI      H'3'            0 to 3 random number
        LR      0,A
        SR      1
        LR      1,A             0 to 1 random number
        LR      A,0
        NI      H'1'
        LR      0,A             2nd 0 to 1 random number
        DCI     BKMV
        LM
        CI      H'7'
        BP      BMV2            Second move case
        DCI     BOK3
        BR      BMV3
        LM
BMV2    SL      1               2 entries for each input 
        AS      0
        DCI     BOK2
BMV3    ADC
        CLR
        XS      1
        LM
        BZ      BKM4
        SR      4
BKM4    NI      H'F'            Use 4 bits only
        LR      0,A             Final selection of move
        PK
*
BOK2    NOP
BOK3    NOP
        END
*Opening move table (choice to be made by a random number from 0 thru 7
BOK1    DC      H'01'   12-16, 11-15
        DC      H'23'   10-14,  9-13
        DC      H'45'   11-16, 10-15
        DC      H'61'    9-14, 11-15
*First replies (maximum of 4 each)
BOK2    DC      H'33'   24,20  24-20    To 12-16
        DC      H'33'   24-20, 24-20
BOKB    DC      H'43'   23-19, 24-20    To 11-15
        DC      H'20'   22-17, 24-19
BOKC    DC      H'22'   22-17, 22-17    To 10-14
        DC      H'22'   22-17, 22-17
BOKD    DC      H'55'   22-18, 22-18    To  9-13
        DC      H'55'   22-18, 22-18
BOKE    DC      H'31'   24-20, 23-18    To 11-16
        DC      H'45'   24-19, 22-18
BOKF    DC      H'66'   21-17, 21-17    To 10-15
        DC      H'66'   21-17, 21-17
BOKG    DC      H'55'   22-18, 22-18    To  9-14
        DC      H'55'   22-18, 22-18
*First counter replies (maximum of 2 each)
BOK3    DC                              To 12-16 24-19
        DC                              To 12-16 23-18
        DC                              To 12-16 22-17
        DC      H'00'    8-12,  8,12    To 12-16 24-20
        DC      H'00'   16-23, 16,23    To 12-16 23-19
        DC                              To 12-16 22-18
        DC                              To 12-16 21-17
        DC      H'00'   15-24, 15-24    To 11-15 24-19
        DC      H'00'    8-11,  8-11    To 11-15 23-18
        DC      H'60     9-13,  8-11    To 11-15 22-17
        DC      H'00'    8-11,  8-11    To 11-15 24-20
        DC      H'05     8-11,  9-14    To 11-15 23-19
        DC      H'00'   15-22, 15-22    To 11-15 22-18
        DC                              To 11-15 21-17
*-*- THERE WILL BE 49 BYTES OF THESE, EACH WITH 2 COUNTER REPLIES
*-*- The ones listed at present are from Lee's Guide
*       END